The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/10/9/DISK1095.ZIP/HRMMNT.PRG

Text File | 1986-10-07 | 8KB | 250 lines

*
* HRMMNT.PRG
* PERSONNEL FILE MAINTENANCE SCREEN
* FILE STRUCTURE MUST ALREADY EXIST
SET HEADING OFF
SET SAFETY OFF
SET STATUS OFF
CLEAR
CLEAR ALL
SET TALK OFF
SET BELL OFF
* DEFINE A STRING OF BLANKS
STORE SPACE(80) TO BLANK
* CLEAR REQUEST AND ACTION CONTROL VARIABLES
STORE " " TO REQUEST
STORE " " TO ACTION
STORE "N" TO DATAIN
STORE 0 TO RECCNT
*
*===============================START MODS: 1================================*
* SET NAME OF FILE                                                           *
STORE "PERSONNL" TO FILENAME
* SETUP COUNT OF INDEXES FOR THE FILE filename
STORE 2 TO IXCOUNT
* SETUP CONSTANTS CONTAINING INDEXES IN SEQUENCE TO USE IN MACRO LATER.
* LIST EACH INDEX FIRST AS A PRIMARY INDEX. VARIABLES NAMED IXA, IXB, IXC, ETC.
STORE "PNAME,PSSAN" TO IXA
* DEFINE KEYS FOR INDEX. IF NUMERIC, MUST CONVERT WITH STR(). USE DI+IXA, ETC.
STORE "LAST_NAME-','-FIRST_NAME" TO DIIXA
STORE "PSSAN,PNAME" TO IXB
STORE "SSAN" TO DIIXB
*==================================END MODS==================================*
*
* SAVE NAME OF MACRO WHICH CONTAINS ACTIVE INDEX AS FIRST INDEX
STORE "IXA" TO LIVE_IX
* FIND RECORD COUNT
USE &FILENAME
COUNT TO RECCNT
* IF DBF FILE HAS NO RECORDS THIS CONDITION WILL PREVENT A 'RECORD OUT OF
* RANGE' ERROR FROM OCCURING WHEN THE ADD OPTION IS CHOSEN FOR THE FIRST TIME.
IF RECCNT = 1
   RECCNT = RECCNT-1
ENDIF
* IF FILE IS EMPTY, ASSUME INDEXES NOT CREATED AND CREATE THEM
  IF RECCNT = 0 .AND. IXCOUNT>0
   STORE 1 TO COUNT
   DO WHILE COUNT<=IXCOUNT
      STORE "IX"+CHR(64+COUNT) TO TEMP
      STORE "DI"+TEMP TO TEMP2
      IF IXCOUNT>1
         STORE SUBSTR(&TEMP,1,AT(",",&TEMP)-1) TO TEMP
      ELSE
         STORE &TEMP TO TEMP
      ENDIF
      STORE &TEMP2 TO TEMP2
      INDEX ON &TEMP2 TO &TEMP
      STORE COUNT+1 TO COUNT
   ENDDO
  ENDIF
* ADD INDEXES
SET INDEX TO &IXA
* POSITION AT FIRST RECORD IN LIVE INDEX SEQUENCE FOR INITIAL DISPLAY
GO TOP
*
* MAIN UPDATE LOOP. TERMINATED BY 'M' AS REQUEST
DO WHILE REQUEST<>"M"
*
*===============================START MODS: 2================================*
* DISPLAY SCREEN MASK: HEADING INFORMATION PLUS LABELS FOR EACH FIELD        *
   @ 1,22 SAY "SMITH'S BIKEWORKS INFORMATION SYSTEM"
   @ 3,11 SAY ">> Human Resources Management System File Maintenance <<"
   @ 5,17 SAY "Today's Date:"
   ?? DATE()
* SETUP VARIABLE PART OF MASK
   CLEAR GETS
   @ 7,1  SAY "EMPLOYEE ? " GET HIRED
   @ 7,40 SAY "SSAN " GET SSAN
   @ 8,1  SAY "Name --Last " GET LAST_NAME
   @ 8,38 SAY "First " GET FIRST_NAME
   @ 8,63 SAY "Initial " GET INITIAL
   @ 10,1 SAY "Street " GET STREET
   @ 10,36 SAY "City " GET CITY
   @ 10,58 SAY "State " GET STATE
   @ 10,69 SAY "Zip " GET ZIP
   @ 11,1  SAY "Education -- Grades " GET GRADE_SCHL
   @ 11,30 SAY "College " GET COLLEGE
   @ 11,45 SAY "Phys Limits " GET PHYS_LIMIT
   @ 13,1  SAY "Sex " GET SEX
   @ 13,10 SAY "Marital Status " GET MAR_STATUS
   @ 13,31 SAY "Birth Date " GET BIRTH_DATE PICTURE "99/99/99"
   @ 15,1  SAY "Hourly ? " GET HOURLY
   @ 15,14 SAY "Rate/Salary " GET PAY_RATE
   @ 15,36 SAY "Overtime Factor " GET OVER_TIME
   @ 15,59 SAY "Exemptions " GET EXEMP
   @ 16,1 SAY "Year To Date -- Pay $ " GET YTD_PAY
   @ 16,35 SAY "Withholding $ " GET YTD_WTHHLD
   @ 16,60 SAY "FICA $ " GET YTD_FICA
* DATE OF LAST UPDATE SHOULD BE ONE OF THE FIELDS (LAST_UPDT)
   @ 18,1 SAY "Last Updated : "
   ?? LAST_UPDT
*==================================END MODS==================================*
*
* DISPLAY VARIABLE DATA IN SCREEN HEADING
   IF DELETE()
      @ 5,1 SAY "* DELETED *"
   ELSE
      @ 5,1 SAY "           "
   ENDIF
* IDENTIFY RECORD
   @ 5,62 SAY RECCNT
   @ 5,50 SAY RECNO()
   @ 5,43 SAY "Record"
   @ 5,61 SAY "of"
* IF DATAIN FLAG SET, ACTIVATE THE GETS
   IF DATAIN="Y"
      @ 19,72 GET ACTION
      READ
* DATE STAMP RECORD
      REPLACE LAST_UPDT WITH DATE()
      IF REQUEST="E".OR.ACTION<>"C"
         STORE "N" TO DATAIN
         STORE " " TO REQUEST
         STORE " " TO ACTION
      ENDIF 2
   ELSE
      CLEAR GETS
   ENDIF 1
*
* DISPLAY CONTROL SUBMENU, CURRENT ACTIVE INDEX
   @ 19,0 SAY BLANK
   @ 20,0 SAY "----------------------------------------"
   @ 20,40 SAY "----------------------------------------"
   @ 21,0 CLEAR
   @ 21,2 SAY ;
"<F>ind Record  <A>dd Record   <D>elete/Recall  <E>dit Record   Current Active"
   @ 22,2 SAY ;
"<P>rev Record  <N>ext Record  <M>enu (return)  <K>ey Select    Key:          "
* IF INDEX SET NAMED IN LIVE_IX HAS MULTIPLE ENTRIES, EXTRACT FIRST
   IF (","$&LIVE_IX)
      STORE SUBSTR(&LIVE_IX,1,AT(",",&LIVE_IX)-1) TO TEMP
      @ 22,70 SAY TEMP
   ELSE
      @ 22,70 SAY &LIVE_IX
   ENDIF
* GET REQUEST AND FORCE TO UPPER CASE UNLESS ALREADY IN 'A' FOR ADD RECORDS
   IF REQUEST<>"A"
      STORE " " TO REQUEST
      STORE " " TO ACTION
      @ 23,10 SAY "          *** NEXT ACTION TO PERFORM " GET REQUEST
      READ
      STORE UPPER(REQUEST) TO REQUEST
   ENDIF
* CLEAR ADD RECORD COMMAND LINE, SUBMENU AREA
   @ 21,0 CLEAR
   DO CASE
* ADD NEW CASE OR EDIT DISPLAYED CASE
      CASE REQUEST="A".OR.REQUEST="E"
* IN ADD MODE, APPEND A BLANK RECORD FOR THE DATA AND POSITION TO THAT RECORD
         IF REQUEST="A"
            @ 19,6 SAY "*** PRESS 'C' TO CONTINUE ADDING NEW RECS, ANYTHING ;
ELSE TO QUIT"
            APPEND BLANK
            STORE RECCNT+1 TO RECCNT
            GO RECCNT
         ELSE
            @ 19,6 SAY "******** PRESS ANY KEY TO FINISH EDIT AND RETURN TO ;
SUBMENU     "
         ENDIF
         @ 21,10 SAY "Enter data at cursor position. Move among fields with"
         @ 22,10 SAY "cursor control keys. Press ENTER to move to next field."
         @ 23,10 SAY "Press ENTER alone to leave field unchanged."
* SET FLAG TO CAUSE NEW DATA TO BE READ
         STORE "Y" TO DATAIN
* TOGGLE DELETE FLAG. * FUNCTION CHECKS IF RECORD NOW FLAGGED AS DELETED
      CASE REQUEST="D"
         IF DELETE()
            RECALL
         ELSE
            DELETE
         ENDIF
* PREVIOUS RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="P"
         SKIP -1
* NEXT 3 LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ENDIF
* NEXT RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="N"
         SKIP +1
* NEXT 3 LINES SECURE THE FOWARD LOOP
         IF EOF()
            GO TOP
         ENDIF
* GET SEARCH VALUE FOR INDEXED SEARCH
      CASE REQUEST="F"
* USE MACRO DEFINING INDEX ENTRIES FROM DATA FIELDS
         STORE "DI"+LIVE_IX TO IXDEF
         STORE &IXDEF TO SV
         STORE &SV TO SV
         @ 21,1 SAY ;
         "ENTER SEARCH VALUE. VALUE SHOWN IS FROM THE DISPLAYED RECORD. PRESS"
         @ 22,1 SAY "CTRL-Y TO CLEAR " GET SV
         READ
* REMOVE TRAILING BLANKS BEFORE SEARCH
         STORE TRIM(SV) TO SEARCH
* IF RECORD IS NOT FOUND DISPLAY STAYS AT CURRENT RECORD
* NEXT LINE TO KEEP TRACK OF CURRENT RECNO() FOR TEST BELOW
         STORE RECNO() TO NOW
         SEEK SEARCH
* NEXT THREE LINES KEEP PRESENT RECORD DISPLAYED IF NO FIND
         IF EOF()
            GOTO NOW
         ENDIF
* CHANGE INDEX
      CASE REQUEST="K"
         STORE RECNO() TO RECNOW
         STORE " " TO IXCHOICE
* SETUP MENU OF INDEX NAMES, PROVIDE IF CLAUSE FOR EACH INDEX                *
         @ 21,9 SAY " "
         STORE 1 TO COUNT
         DO WHILE COUNT<=IXCOUNT
            STORE "IX"+CHR(64+COUNT) TO TEMP
            IF IXCOUNT>1
               ?? CHR(64+COUNT)+". "+SUBSTR(&TEMP,1,AT(",",&TEMP)-1)+" "
            ELSE
               ?? CHR(64+COUNT)+". "+&TEMP
            ENDIF
            STORE COUNT+1 TO COUNT
         ENDDO
         @ 22,10 SAY "Press letter of desired key " GET IXCHOICE
         READ
         STORE UPPER(IXCHOICE) TO IXCHOICE
         IF IXCHOICE>="A".AND.IXCHOICE<=CHR(64+IXCOUNT)
            STORE "IX"+IXCHOICE TO LIVE_IX
            STORE &LIVE_IX TO TEMP
            SET INDEX TO &TEMP
         ENDIF
* GOTO THIS RECORD TO ACTIVATE INDEX
         IF RECNOW>0
            GO RECNOW
         ELSE
            GO BOTTOM
         ENDIF
   ENDCASE
ENDDO
* FALL OUT OF DO WHEN 'M' IS REQUEST, RETURN TO SUBSYSTEM'S MENU
CLEAR
RETURN